home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / xlisp.lbr / XLDEBUG.CQ / xldebug.c
Encoding:
C/C++ Source or Header  |  1985-06-03  |  3.0 KB  |  136 lines
  1.                        /* xldebug - some debug routines */
  2.  
  3. #ifdef CI_86
  4. #include "a:stdio.h"
  5. #include "xlisp.h"
  6. #endif
  7.  
  8. #ifdef AZTEC
  9. #include "a:stdio.h"
  10. #include "xlisp.h"
  11. #endif
  12.  
  13. #ifdef unix
  14. #include <stdio.h>
  15. #include <xlisp.h>
  16. #endif
  17.  
  18.  
  19.  
  20. int debug_level = 0;
  21. FILE *debug_fp = NULL;
  22.  
  23.  
  24.  
  25.               /***************************************************
  26.               *  xldbgmsg : Display a message in the debug file  *
  27.               ***************************************************/
  28.  
  29. xldbgmsg(s)
  30.     char *s;
  31. {
  32.     if (debug_fp)
  33.          fprintf(debug_fp, "\n%s", s);
  34. }
  35.  
  36.  
  37.                   /*******************************************
  38.                   *  xldump : dump a node to the debug file  *
  39.                   *******************************************/
  40.  
  41. xldump(nptr)
  42.     struct node *nptr;
  43. {
  44.  
  45.     if (debug_fp == NULL)              /* Debug file open ? */
  46.          return;
  47.  
  48.     fprintf(debug_fp, "\n@%4x : %2x   ", nptr, nptr->n_flags);
  49.  
  50.     switch(nptr->n_type)
  51.     {
  52.     case FREE:
  53.          fprintf(debug_fp, "FREE node");
  54.          return;
  55.  
  56.     case SYM:
  57.          fprintf(debug_fp, "SYM %s = @%4x", nptr->n_symname, nptr->n_symvalue);
  58.          return;
  59.  
  60.     case LIST:
  61.          fprintf(debug_fp, "LIST @%4x , @%4x", nptr->n_listvalue,
  62.                  nptr->n_listnext);
  63.          return;
  64.  
  65.     case SUBR:
  66.          fprintf(debug_fp, "SUBR %4x", nptr->n_subr);
  67.          return;
  68.  
  69.     case INT:
  70.          fprintf(debug_fp, "INT = %d", nptr->n_int);
  71.          return;
  72.  
  73.     case STR:
  74.          fprintf(debug_fp, "STRING = %s", nptr->n_str);
  75.          return;
  76.  
  77.     case OBJ:
  78.          fprintf(debug_fp, "OBJ @%4x , @%4x", nptr->n_obclass,
  79.                  nptr->n_obdata);
  80.          return;
  81.  
  82.     case FPTR:
  83.          fprintf(debug_fp, "FILE  %4x", nptr->n_fp);
  84.          return;
  85.  
  86.     case KMAP:
  87.          fprintf(debug_fp, "KMAP");
  88.          return;
  89.  
  90. #ifdef REALS
  91.     case REAL:
  92.          fprintf(debug_fp, "REAL = %g", nptr->n_real);
  93.          return;
  94. #endif
  95.  
  96.     default:
  97.          fprintf(debug_fp, "Type %d ?????????", nptr->n_type);
  98.          return;
  99.     }
  100. }
  101.  
  102.  
  103.                 /************************************************
  104.                 *  debug : xlisp function to set debug options  *
  105.                 ************************************************/
  106.  
  107. static struct node *debug(args)
  108.     struct node *args;
  109. {
  110.     debug_level = xlevmatch(INT, &args)->n_int;
  111.  
  112.     if (args != NULL)
  113.     {
  114.          if (debug_fp)
  115.               fclose(debug_fp);
  116.          if ((debug_fp = fopen(xlevmatch(STR, &args)->n_str, "w")) == NULL)
  117.               xlfail("Cannot open debug file");
  118.          xllastarg(args);
  119.     }
  120.  
  121.     return (NULL);
  122. }
  123.  
  124.  
  125.                   /*******************************************
  126.                   *  xldebuginit : initialize debug package  *
  127.                   *******************************************/
  128.  
  129. xldebuginit()
  130. {
  131.     debug_leval = 0;
  132.     debug_fp = NULL;
  133.  
  134.     xlsubr("debug", debug);
  135. }
  136.